home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.43 / fontsensitiv / fontsensitiv.unit < prev    next >
Text File  |  1995-01-07  |  6KB  |  218 lines
  1. { Unit:      SimpleFontsensitiv
  2.   Version:   1.3 (22.12.94)
  3.   Sprache:   KP/MP3 OS3.1-Includes
  4.  
  5.   Autor:     PackMAN
  6.              Falk Zühlsdorff
  7.              Lindenberg 66
  8.              98693 Ilmenau
  9.  
  10.              email: ai036@rz.tu-ilmenau.de
  11.  
  12.   Copyright: bei Verwendung von Routinen muß selbiges mit
  13.              Namenszug des Autors im Infofenster und in der
  14.              .dok des jeweiligen Programmes gekennzeichnet sein.
  15.              Bei Sharware / Lowcost erhält der Autor zu jeder
  16.              Version ein kostenloses Exemplar zugeschickt !!!    }
  17.  
  18. UNIT SimpleFontsensitiv;
  19.  
  20. INTERFACE
  21.  
  22. USES INTUITION,GRAPHICS,EXEC,GADTOOLS;
  23.  
  24. TYPE  PenType           = ^ARRAY[0..12] OF WORD;
  25.       pointerfeld       = array[1..40] of Word;
  26.  
  27. VAR   {-------------------- WBScreen / Font... ----------------------}
  28.  
  29.       WBScr             : p_screen;
  30.       drawinfo          : p_drawinfo;
  31.       vi                : PTR;
  32.       txattr            : TextAttr;
  33.       font              : p_textfont;
  34.       ysize,xsize,
  35.       STF,baseline      : WORD;
  36.  
  37.       Pgad,Glist        : p_Gadget;
  38.  
  39.       Pointerptr        : ^Pointerfeld;
  40.       waitreq           : Requester;
  41.  
  42.       PENs              : PenType;
  43.  
  44. {--------------------------------------------------------------------}
  45. PROCEDURE CloseSomeLibs;
  46. PROCEDURE PressButton(VAR WinX:p_Window;VAR gad:p_Gadget);
  47. PROCEDURE SetPoi(ThisWin:p_Window);
  48. PROCEDURE ClearPoi(ThisWin:p_Window);
  49. FUNCTION  Fontsensitiv(XWidth,XHeight:Word,first:boolean):boolean;
  50. PROCEDURE Error(Tx:string);
  51. FUNCTION  V37:boolean;
  52. {--------------------------------------------------------------------}
  53. IMPLEMENTATION
  54. {--------------------------------------------------------------------}
  55. PROCEDURE Error;
  56. VAR ErrorTextAttr : TextAttr;
  57.     ITx,ITxGad    : IntuiText;
  58.     dummy         : boolean;
  59. BEGIN
  60.  ErrorTextAttr:=TextAttr('topaz.font',8,0,0);
  61.  ITx:=IntuiText(2,0,0,20,10,^ErrorTextAttr,Tx,NIL);
  62.  ITxGad:=IntuiText(2,0,0,2,3,^ErrorTextAttr,'OK',NIL);
  63.  dummy:=AutoRequest(NIL,^ITx,NIL,^ITxGad,0,0,330,80);
  64. END;
  65. {--------------------------------------------------------------------}
  66. PROCEDURE CloseSomeLibs;
  67. BEGIN
  68.  IF IntuitionBase<>NIL THEN CloseLib(IntuitionBase);
  69.  IF GfxBase<>NIL       THEN CloseLib(GfxBase);
  70.  IF Gadtoolsbase<>NIL  THEN CloseLib(Gadtoolsbase);
  71. END;
  72. {--------------------------------------------------------------------}
  73. PROCEDURE PressButton;
  74. VAR class,code,IDCMP1 : long;
  75.     help              : boolean;
  76.     Msg               : p_IntuiMessage;
  77. BEGIN
  78.  IDCMP1:=WinX^.IDCMPFlags;
  79.  help:=ModifyIDCMP(WinX,IDCMP_RAWKEY);
  80.  gad^.Flags:=gad^.Flags+SELECTED;
  81.  RefreshGList(gad,WinX,NIL,1);
  82.  REPEAT
  83.   Msg:=Wait_Port(WinX^.UserPort);
  84.   Msg:=GT_GetIMsg(WinX^.UserPort);
  85.   class:=msg^.class;
  86.   code:=msg^.Code;
  87.   GT_ReplyIMsg(Msg);
  88.  UNTIL (class=IDCMP_RAWKEY) AND ((code AND $80)=$80);
  89.  delay(1);
  90.  help:=ModifyIDCMP(WinX,IDCMP1);
  91.  gad^.Flags:=gad^.Flags-SELECTED;
  92.  RefreshGList(gad,WinX,NIL,1);
  93. END;
  94. {--------------------------------------------------------------------}
  95.  PROCEDURE SetPoi;
  96.  VAR dummy:boolean;
  97.  BEGIN
  98.   InitRequester(^waitReq);
  99.   dummy:=Request(^waitReq,ThisWin);
  100.   SetPointer(ThisWin,PointerPTR,16,16,-6,-1);
  101.  END;
  102. {--------------------------------------------------------------------}
  103.  PROCEDURE ClearPoi;
  104.  BEGIN
  105.   ClearPointer(ThisWin);
  106.   EndRequest(^waitReq,ThisWin);
  107.  END;
  108. {--------------------------------------------------------------------}
  109. FUNCTION Fontsensitiv;
  110. VAR dummy : long;
  111.     zei   : char;
  112.  
  113. PROCEDURE stopit;
  114. BEGIN
  115.  FreeGadgets(glist);
  116.  FreeVisualInfo(vi);
  117.  CloseSomeLibs;
  118.  Fontsensitiv:=false;
  119. END;
  120.  
  121. BEGIN
  122.  WBScr:=NIL;
  123.  WBScr:=lockpubscreen('Workbench');
  124.  IF WBScr<>NIL
  125.   THEN
  126.    BEGIN
  127.     drawinfo:=NIL;
  128.     drawinfo:=getscreendrawinfo(WBScr);
  129.     Pgad:=NIL;
  130.     Pgad:=CreateContext(^Glist);
  131.     IF (drawinfo<>NIL) AND  (pgad<>nil)
  132.      THEN
  133.       BEGIN
  134.        font:=drawinfo^.dri_font;
  135.        xsize:=0;
  136.        FOR zei:=chr($00) TO chr($5E) DO
  137.         BEGIN
  138.          ysize:=textlength(^WBScr^.rastport,zei,1); {hier HilfsVAR}
  139.          IF ysize>xsize THEN xsize:=ysize;
  140.         END;
  141.        ysize:=textlength(^WBScr^.rastport,' ',1);   {hier HilfsVAR}
  142.        IF ysize>xsize THEN xsize:=ysize;
  143.  
  144.        ysize:=font^.tf_ysize;
  145.        STF:=ysize;
  146.        txattr:=
  147.         TextAttr(drawinfo^.dri_font^.tf_Message.mn_Node.ln_Name,
  148.                  ysize,0,0);
  149.        vi:=GetVisualinfoA(WBScr,nil);
  150.        freescreendrawinfo(WBScr,drawinfo);
  151.        UnlockPubScreen(NIL,WBScr);
  152.        IF (xsize*XWidth>WBScr^.width) OR
  153.           ((XHeight*ysize+STF)>WBScr^.height)
  154.         THEN
  155.          BEGIN
  156.           IF (8*XWidth>WBScr^.width) OR
  157.              ((8*XHeight+STF)>WBScr^.height)
  158.            THEN
  159.             BEGIN
  160.              Error('Screen zu klein...');
  161.              stopit;
  162.              exit;
  163.             END
  164.            ELSE
  165.             BEGIN
  166.              ysize:=8;
  167.              xsize:=8;
  168.              txattr:=TextAttr('topaz.font',ysize,0,0);
  169.              Font:=OpenFont(^txattr);
  170.             END
  171.          END;
  172.       END
  173.      ELSE
  174.       BEGIN
  175.        Error('Can`t run program...');
  176.        Fontsensitiv:=false;
  177.        exit;
  178.       END;
  179.    END
  180.   ELSE   {für den Fall, daß alles zu spät ist...}
  181.    BEGIN
  182.     Error('Can`t find WBench-Screen');
  183.     Fontsensitiv:=false;
  184.     exit;
  185.    END;
  186.  
  187.  baseline:=font^.tf_baseline;
  188.  
  189.  PENs:=PenType(drawinfo^.dri_Pens);
  190.  
  191.  IF first
  192.   THEN
  193.    BEGIN
  194.     PointerPTR:=NIL;
  195.     PointerPTR:=PTR(Alloc_Mem(SizeOf(pointerfeld),
  196.                     MEMF_CHIP+MEMF_CLEAR));
  197.     IF PointerPTR=NIL
  198.      THEN BEGIN CloseSomeLibs; Fontsensitiv:=false; exit;END;
  199.     PointerPTR^:=Pointerfeld
  200.      ($0000,$0000,$0400,$07c0,$0000,$07c0,$0100,$0380,
  201.       $0000,$07e0,$07c0,$1ff8,$1ff0,$3fec,$3ff8,$7fde,
  202.       $3ff8,$7fbe,$7ffc,$ff7f,$7efc,$ffff,$7ffc,$ffff,
  203.       $3ff8,$7ffe,$3ff8,$7ffe,$1ff0,$3ffc,$07c0,$1ff8,
  204.       $0000,$07e0,$0000,$0000,$0000,$03f2,$0000,$0000);
  205.    END;
  206.  Fontsensitiv:=true;
  207. END;
  208. {---------------------------------------------------------------------}
  209. FUNCTION V37;
  210. VAR lib:p_library;
  211. BEGIN
  212.  lib:=sysbase;
  213.  V37:=(lib^.lib_version>=37);
  214. END;
  215. {---------------------------------------------------------------------}
  216. END.
  217.  
  218.